perm filename MS.SAI[X,ALS] blob
sn#081295 filedate 1974-01-14 generic text, type T, neo UTF8
00010 BEGIN "MARKX"
00020 DEFINE ⊂="COMMENT"; ⊂ NOV.26,1973;
00030 ⊂ This program is a very simple pitch marking routine to be used to
00040 suppliment Neil's routine in certain cases;
00060 DEFINE ⊃="⊂";
00070 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00080 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00090 LABEL STARTP,STOPP,TOFORM;
00100 DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00120 INTEGER SUM,SUMM,SUMP,MAX,MIN,QSAVE,
00130 SUMREF,SUMSAV,SUMMIN,SUMMAX,SUMOLD;
00140 INTEGER MAXOLD,MINOLD,MARGIN,PER,PERMIN,PERMAX;
00150 INTEGER QOLD,QSAV,QREF;
00170 INTEGER ZEROC,ZEROF,DX;
00260 EXTERNAL INTEGER INFLAG,NX;
00270 \ INTERNAL INTEGER ARRAY D[0:512];
00280 REAL X,SX; \ REAL ARRAY WINDOW[0:512];
00290 INTERNAL REAL R0;
00300 INTEGER LPCOPT;
00310 \ INTEGER ARRAY DPYBUF[0:1535];
00350 \ INTERNAL INTEGER ARRAY FVAL,NVAL[0:8];
00360 \ EXTERNAL INTEGER ARRAY NEW[0:512];
00380 INTEGER FX;
00400 INTEGER I,J,K,L,P,PP,Q,QQ,R,DK,DDK,DDDK,DVAL,DDVAL,DDDVAL,
00410 POINTF,POINTX,STATE,DELTA,VAL,CHAN1,EOF,POINTT,POINTV;
00420 INTERNAL INTEGER M,N,PERIOD;
00430 INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,
00440 PTCNT,PICK,JP,JPX,OPT,OPT1,SHUFCT;
00450 INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,EOFT,EOFTF,READ3,LFX,PITX,PITY,
00460 SEGTOT,SEGIN,KKT,NNT,ITT,JTT,KTT;
00470 BOOLEAN ER;
00480 INTEGER CHAN2,CHAN3,CHAN4,CHAN6,CHANX;
00490 INTERNAL INTEGER CHAN5;
00500 \ INTEGER ARRAY BUF,BUFT,BUFTT[0:511];
00510 STRING FILEN,FILEF,READ,READ1,READT,
00515 READTT,FILEO,READ2,FILEQ,TFILE,FILLST,FILEP;
00520
00530 PROCEDURE OUTALL(STRING S);
00540 BEGIN
00550 STRING SS; INTEGER J;
00560 SETBREAK(18,0,NULL,"OSN");
00570 SS←SCAN(S,18,J);
00580 OUTSTR(SS);
00590 END;
00600
00610 PROCEDURE DATAIN;
00620 BEGIN
00630 INTEGER J;
00640 FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00650 ⊂ IF EOF=0 THEN OUTSTR("BUF") ELSE OUTSTR(" EOF ");
00660 IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512);
00670 ⊂ IF EOF=0 THEN OUTSTR(" New BUF ") ELSE OUTSTR(" EOF ");
00680 POINTX←POINT(12,BUF[0],-1);
00690 SEGC←II←II+12; JJ←II+11;
00700 END;
00710
00720
00730 PROCEDURE DTTTIN;
00740 BEGIN
00750 INTEGER J;
00760 IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512)
00770 ELSE OUTSTR
00780 ("No more .P data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00790 FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00800 ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00810 ⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00820 END;
00830
00840
00850 PROCEDURE DATOUT;
00860 BEGIN "DATOUT"
00870 INTEGER I,J;
00880
00890 ARRYOUT(CHAN5,BUFT[0],512);
00900 FOR I←0 STEP 1 UNTIL 511 DO BUFT[I]←0;
01000 END "DATOUT";
01005
01010
01970 PROCEDURE MARK;
01980 BEGIN "MARK"
01990 INTEGER I,JJ,K,L,JJP,LP,PT2;
02000
02010 RIVECT(0,-130); SETFORMAT(3,0);
02020 FOR I←0 STEP 20 UNTIL 340 DO BEGIN
02030 DPYSST(CVS(I)); RIVECT(15,0); END;
02040 RIVECT(-555,30); RIVECT(-500,0);
02050
02060 FOR I←0 STEP 100 UNTIL 300 DO BEGIN "HUNDRED"
02070 RIVECT(0,30); RVECT(0,-30);
02080 FOR JJ←0 STEP 50 UNTIL 50 DO BEGIN "FIFTY"
02090 FOR K←1 STEP 1 UNTIL 5 DO BEGIN "TEN"
02100 RIVECT(15,0); RVECT(0,5); RIVECT(0,-5);
02110 RIVECT(15,0); RVECT(0,10);RIVECT(0,-10);
02120 END "TEN";
02130 RVECT(0,20); RIVECT(0,-20);
02140 IF I≥300 THEN DONE "HUNDRED";
02150 END "FIFTY";
02160 END "HUNDRED";
02170 RIVECT(-550,100); RIVECT(-500,0);
02180
02190 K←D[0]%8; RIVECT(0,K);
02200 FOR I←1 STEP 1 UNTIL 350 DO BEGIN
02210 JJP←D[I]%8;
02220 LP←JJP-K; RVECT(3,LP); K←JJP; END;
02230 RIVECT(-550,-K); RIVECT(-500,0);
02240
02250 RIVECT(500,0);
02260 FOR JJ←1 STEP 1 UNTIL 2 DO IF FVAL[JJ]≤375 THEN BEGIN
02270 L←3*FVAL[JJ]-500;
02280 RIVECT(L,120); RVECT(0,-70); RIVECT(0,-25); RVECT(0,-25);
02285 RIVECT(-25,0); RVECT(50,0);
02287 RIVECT(-25,0); RVECT(0,-25); RIVECT(0,-25); RVECT(0,-50);
02289 RIVECT(-L,100); END;
02291
02292 FOR JJ←1 STEP 1 UNTIL 2 DO IF NVAL[JJ]≤375 THEN BEGIN
02293 L←3*NVAL[JJ]-500;
02294 RIVECT(L,100); RVECT(0,-100); RIVECT(-25,0); RVECT(50,0);
02295 RIVECT(-25,0); RVECT(0,-120); RIVECT(-L,120); END;
02297
02300 RIVECT(-500,0);
02310 DPYOUT(0); PTOCHW(0,'10120);
02320
02330 END "MARK";
02340
02350 INTERNAL PROCEDURE CALCOMP(STRING FILE;INTEGER ARRAY BUFR);
02360 ⊃ Outputs display buffer BUFR to disk file FILE in a format
02370 readable by the Nealy Calcomp plotter program PLTVEC, and by
02380 the Quam Video Synthesizer program MIRTOP;
02390 IF FILE THEN
02400 BEGIN INTEGER DSIZ,CCCHN;
02410 OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
02420 ENTER(CCCHN,FILEN&".GRF",0);
02430 DPYPARS;DSIZ←BUFR[1]+4;
02440 ARRYOUT(CCCHN,BUFR[0],2);WORDOUT(CCCHN,0);
02450 ARRYOUT(CCCHN,BUFR[2],DSIZ-2);
02460 RELEASE(CCCHN);
02470 END "CALCOMP";
02480
02490
03000 PROCEDURE PITCH;
03010 BEGIN "PITCH"
03020
03100 CASE STATE OF BEGIN
03110
03120 ⊂ STATE 0 INDETERMINATE STATE;
03130 IF VAL>0 THEN
03140 BEGIN
03150 STATE←1; SUM←MAX←MIN←SUMREF←SUMOLD←0; SUMP←VAL;
03160 END;
03170
03180 ⊂ STATE 1 INITIAL POSITIVE STATE;
03190 IF VAL<0 THEN
03200 BEGIN
03210 IF SUM<MARGIN THEN STATE←0 ELSE
03220 BEGIN
03230 STATE←4; SUM←SUMOLD+SUMP-VAL;
03240 MAX←MAXOLD; MIN←MINOLD;
03250 IF VAL<MIN THEN MIN←VAL;
03260 END;
03270 END ELSE
03280 BEGIN
03290 SUMP←SUMP+VAL;
03300 IF VAL>MAX THEN MAX←VAL;
03310 IF SUMP>DELTA THEN
03320 BEGIN
03330 STATE←2; SUM←SUMP;
03350 P←0; PER←QOLD-QREF;
03370 IF SUMSAV=SUMREF ∧ PER≥PERIOD THEN
03375 BEGIN OUTSTR("CONDITION 1 "); P←1; END ELSE
03380 IF SUMOLD<SUMSAV THEN begin OUTSTR("CONDITION 2");
03385 SUMSAV←SUMOLD ; END ELSE
03390 IF PER>PERIOD*5%4 THEN BEGIN OUTSTR("CONDITION 3");
03395 P←1; end ELSE
03400 IF (SUMOLD≥SUMREF*3%4) ∧ PER≥PERIOD*3%4 THEN
03405 BEGIN OUTSTR("CONDITION 4"); P←1; end;
03410
03420 IF P=1 THEN
03422 BEGIN
03425 OUTSTR("QQ="&CVS(QQ)&" PER="&CVS(PER)&" SUMOLD="&CVS(SUMOLD)
03427 &" PERIOD="&CVS(PERIOD)&" PITX="&CVS(PITX)&CRLF);
03428 BUFT[PITX]←(QOLD LSH 15)+(SUMREF LSH -6);
03430 SUMREF←SUMOLD;
03440 IF SUMREF<SUMMIN THEN SUMREF←SUMMIN;
03450 PERIOD←(2*PERIOD+PER)%3;
03460 IF PERIOD<PERMIN THEN PERIOD←PERMIN ELSE
03470 IF PERIOD>PERMAX THEN PERIOD←PERMAX;
03485 IF (PITX←PITX+1)≥512 THEN DATOUT;
03490 QREF←QOLD;
03500 END;
03510
03520 END;
03530 END;
03540
03550 ⊂ STATE 2 CONFIRMED POSITIVE STATE;
03560 IF VAL>0 THEN
03570 BEGIN
03580 SUM←SUM+VAL; IF VAL>MAX THEN MAX←VAL;
03590 END ELSE
03600 BEGIN
03610 STATE←3; SUMM←-VAL; MIN←VAL;
03620 END;
03630
03640 ⊂ STATE 3 INITIAL NEGATIVE STATE;
03650 IF VAL>0 THEN
03660 BEGIN
03670 IF SUM<MARGIN THEN STATE←0 ELSE
03680 BEGIN
03690 STATE←2; SUM←SUM+SUMM+VAL;
03700 IF VAL>MAX THEN MAX←VAL;
03710 END;
03720 END ELSE
03730 BEGIN
03740 SUMM←SUMM-VAL;
03750 IF VAL<MIN THEN MIN←VAL;
03760 IF SUMM>DELTA THEN
03770 BEGIN
03780 STATE←4; SUM←SUM+SUMM;
03790 END;
03800 END;
03810
03820 ⊂ STATE 4 CONFIRMED NEGATIVE STATE;
03830 IF VAL<0 THEN
03840 BEGIN
03850 SUM←SUM-VAL; IF VAL<MIN THEN MIN←VAL;
03860 END ELSE
03870 BEGIN
03880 STATE←1; QOLD←QSAVE; SUMOLD←SUM;
03890 MAXOLD←MAX; MINOLD←MIN;
03895 min←sum←0;
03900 SUMP←MAX←VAL; QOLD←QQ;
03910 END;
03920
03930 END;
03940 OUTSTR("State="&cvs(state)&" VAL="&CVS(VAL)&" QQ="&CVS(QQ)&
03950 " PITX="&CVS(PITX)&" SUM="&CVS(SUM)&" SUMP="&CVS(SUMP)&
03955 " SUMM="&CVS(SUMM)&" SUMOLD="&CVS(SUMOLD)&CRLF);
03960 QQ←QQ+1;
03970
03980 IF (QQ-QREF)≥PERIOD*3%2 THEN BEGIN
03990 BUFT[PITX]←(QREF+PERIOD) LSH 15;
03994 ⊂ OUTSTR("QQ="&CVS(QQ)&" PER="&CVS(PER)&" SUMOLD="&CVS(SUMOLD)
03996 &" PERIOD="&CVS(PERIOD)&" PITX="&CVS(PITX)&CRLF);
04000 PITX←PITX+1; QREF=QOLD←QREF+PERIOD; STATE←SUM←0;
04010 END;
04020 END "PITCH";
00010 FILEN←"HI20.001[CMP,VIN]";
00020 FILEO←"SEG1.ALS[SYN,ALS]";
00025 PERIOD←180; PERMAX←220; PERMIN←100; MARGIN←200; DELTA←500; QQ←0;
00032 SUMMIN←DELTA;
00040 STDBRK(1);
00050 SETBREAK(14,"∃",NULL,"INS");
00060 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00070 SETBREAK(16,'56,NULL,"INA");
00080 SETBREAK(17,'12,'15,"INS");
00090
00100 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00110 OUTSTR("This program generates a file of pitch markers similar to "&
00120 "the .P files"&CRLF&" but with extension of .ALS."&CRLF);
00160 OUTSTR("At present this program takes acoustic data from [CMP,VIN],"&
00180 CRLF&TB&"and pulse informstion from .P[PIT,NJM] files"&CRLF&TB&CRLF&LF);
00210
00370
00380 STARTP:
00390
00400 OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00410 IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00420
00430 ⊂ Begin FILEREAD;
00440 FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00450 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00460 SETFORMAT(-3,0); FILEQ←CVS(PP);
00470 FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,VIN]";
00480 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00490 WHILE ER DO BEGIN
00500 IF PP>1 THEN BEGIN OUTSTR("Out of data, will terminate."&CRLF);
00510 GOTO STOPP; END;
00520 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00530 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00540 J←K←L←STATE←VAL←0; R←-1;
00550 SETFORMAT(1,0); FILEQ←CVS(PP); JP←FVAL[0]←1000; R←-1; CLRBUF;
00560 II←-11; JJ←-1;
00570
00580 DATAIN; SUMREF←SUMOLD←SUMSAV←0;
00585 PITX←0; BUFT[PITX]←1; PITX←1; SUMREF←0;
00590 FOR J←0 STEP 1 UNTIL 511 DO BEGIN
00600 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00605 D[J]←VAL; PITCH; END;
00610 SEGIN←4; FVAL[1]←FVAL[2]←0;
00620
00780
00790 FILEP←FILEO[1 TO 3]&FILEQ&".ALS[SYN,ALS]";
00800 CLOSE(CHAN5); OPEN(CHAN5,"DSK",'14,0,2,0,0,0);
00810 ENTER(CHAN5,FILEP,0);
00820 OUTSTR("File "&FILEP&" has been opened"&CRLF);
00850
00858
00860 READ2←FILEP;
00870 READTT←SCAN(READ2,16,J)&"P[PIT,NJM]";
00880 ⊂ OUTSTR(READTT&CRLF);
00890 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
00900 LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
00910 IF ER THEN BEGIN
00920 OUTSTR("File "&READTT&" not found (S to start, space bar to ignore) ");
00930 IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
00940 BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
00950 CLRBUF; END; END;
00960
00970 FOR I←1 STEP 1 UNTIL 8 DO FVAL[I]←0; FVAL[0]←10000;
00980 DTTTIN;
00990 FVAL[6]←BUFTT[0]; FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-4)*128;KTT←0;
00995 NVAL[5]←BUFT[0]; NVAL[3]←(NVAL[5] LSH -15)-(SEGIN-4)*128;
00996 NVAL[6]←BUFT[1]; NVAL[3]←(NVAL[6] LSH -15)-(SEGIN-4)*128; PITY←2;
00997 PERIOD←180; QQ←0;
01000
01010
01020
01030
01040 ⊂ Begin "GET";
01050
01060 WHILE TRUE DO BEGIN "GET"
01070
01090
01100 ⊂ OUTSTR("JTT="&CVS(JTT)&TB&"J="&CVS(J)&CRLF);
01110 IF JJ<SEGIN THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
01120
01130 ⊂ OUTSTR("JJ="&CVS(JTT)&TB&"J="&CVS(J)&"before DTTTIN");
01140 IF JTT<(SEGIN-1)*128 THEN DTTTIN;
01150 ⊂ OUTSTR(" and after JTT="&CVS(JTT)&CRLF);
01160
01170 ⊂ FVAL and NVAL assignments (NVAL are newly computed values)
01180 [1] DELTA FOR FIRST MARKER
01190 [2] DELTA FOR SECOND MARKER
01200 [3] DELTA FOR THIRD MARKER
01210 [4] PULSE DATE FOR FIRST MARKER
01220 [5] PULSE DATA FOR SECOND MARKER
01230 [6] PULSE DATA FOR THIRD MARKER;
01240
01250
01260 FVAL[1]←FVAL[2]; FVAL[4]←FVAL[5];
01265 NVAL[1]←NVAL[2]; NVAL[4]←NVAL[5];
01270
01280 OUTSTR(CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&
01290 TB&CVS(FVAL[4] LSH -15)&
01300 " "&CVS(FVAL[5] LSH -15)&" "&CVS(FVAL[6] LSH -15)&CRLF);
01304 OUTSTR(CVS(NVAL[1])&TB&CVS(NVAL[2])&TB&CVS(NVAL[3])&
01305 TB&CVS(NVAL[4] LSH -15)&
01306 " "&CVS(NVAL[5] LSH -15)&" "&CVS(NVAL[6] LSH -15)&CRLF);
01310 WHILE (FVAL[1]>127)∧(NVAL[1]>127) DO BEGIN
01320 IF SEGIN≥JJ THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
01330 FOR Q←0 STEP 1 UNTIL 383 DO D[Q]←D[Q+128];
01340 FOR Q←384 STEP 1 UNTIL 511 DO BEGIN
01350 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
01360 D[Q]←VAL; PITCH; END; SEGIN←SEGIN+1;
01370 FVAL[1]←FVAL[1]-128; FVAL[3]←FVAL[3]-128;
01375 NVAL[1]←NVAL[1]-128; NVAL[3]←NVAL[3]-128; END;
01380
01390 IF (FVAL[3]-FVAL[1])>PERIOD*2 THEN BEGIN
01395 FVAL[7]←FVAL[2]←FVAL[1]+PERIOD;
01400 FVAL[5]←(FVAL[4] LAND '377777700000)+(PERIOD LSH 15); END
01420 ELSE BEGIN FVAL[2]←FVAL[3]; FVAL[5]←FVAL[6];
01430 KTT←KTT+1; IF KTT≥512 THEN DTTTIN;
01440 FVAL[6]←BUFTT[KTT];
01450 FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-4)*128;END;
01451
01452 NVAL[2]←NVAL[3]; NVAL[5]←NVAL[6];
01453 PITY←PITY+1;
01454 NVAL[6]←BUFT[PITY];
01455 NVAL[3]←(NVAL[6] LSH -15)-(SEGIN-4)*128;
01456
01460
01470 ⊂ OUTSTR(CRLF&CVS(SEGIN)&TB&CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&TB&
01480 CVS(FVAL[4] LSH -15)&
01490 " "&CVS(FVAL[5] LSH -15)&" "&CVS(FVAL[6] LSH -15)&TB&TB);
01500
01590
01600 R←R+1; OUTSTR(CVS(FVAL[4] LSH -15)&TB); IF (R MOD 10)=9 THEN OUTSTR(CRLF);
01610
01640
01650 JP←JP-1; READ1←INCHRS;
01660 IF (READ1="F")∨(READ1="f") THEN BEGIN CLRBUF; READ1←"";
01670 JP←-10; OUTSTR(CRLF&LF&"Will stop at the end of this file"&CRLF&LF); END;
01680 IF (READ1="E")∨(READ1="e") then goto stopp;
01681
01690 IF (READ1=" ")∨(JP=0)∨(FVAL[0]=FVAL[1])∨(ABS(FVAL[1]-NVAL[1])>50)
01691 ∨(ABS(FVAL[2]-NVAL[2])>50) THEN BEGIN "SHOW"
01700 TYPLOC(512,170); DPYSET(DPYBUF);
01710 JP←FVAL[0]←10000;
01720 OUTSTR(CRLF&"File "&FILEN&CRLF);
01730 OUTSTR(CRLF&"Data for interval from "&CVS(FVAL[4] LSH -15)
01740 &" to "&CVS(FVAL[5] LSH -15)&CRLF);
01850 AIVECT(-599,0);MARK;
01870 DPYOUT(0);PTOCHW(0,'10120);
01880 ⊂ OUTSTR("Type P for XGP copy file or type next command.");
01890 OUTSTR("Space to run, LF for next, # for sample #, +# to add periods."&CRLF);
01920
01930 READ1←INCHRW;
01940 WHILE (READ1="W")∨(READ1="w") DO BEGIN DPYOUT(0) ;
01950 PTOCHW(0,'10120);READ1←INCHRW; END;
01960 IF (READ1="P")∨(READ1="p") THEN BEGIN CALCOMP("PLOTX",DPYBUF);
01970 OUTSTR("EX DPYXGP[X,ALS] plots PLOTX.GRF on the XGP. Next command please."&CRLF);
01980 READ1←INCHRW; END;
01990 K←CVASC(READ1); OPT1←0;
02000
02010 IF K=CVASC("+") THEN BEGIN
02020 JP←CVD(INCHWL); FVAL[0]←10000; END;
02030 IF K≥CVASC("0") THEN IF K≤CVASC("9") THEN BEGIN
02040 FVAL[0]←INCHWL; JP←10000; END;
02050 OUTSTR(CR);
02060 IF READ1=" " THEN FVAL[0]←JP←10000;
02070 IF(READ1="F")∨(READ1="f") THEN JP←-1;
02080 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
02090
02100 IF (READ1='15)∨(READ1='12) THEN BEGIN JP←1; CLRBUF; END;
02110
02120 TOFORM:
02130 IF (READ1="S")∨(READ1="s") THEN JP←JP+1;
02140 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
02150 PTOCHW(0,'10103); CLRBUF; TYPLOC(512,-170); PTOCHW(0,'10120);
02160 END "SHOW";
02170
02180
02190 END "GET";
02200 CLOSE(CHAN1); CLOSE(CHAN3);
02210 DATOUT; CLOSE(CHAN5);
02230 IF JP<0 THEN DONE;
02240 END "FILEREAD";
02250
02260 OUTSTR("Data are exhausted"&CRLF&LF);
02270 STOPP: PTOCHW(0,'10103); PTOCHW(0,'10120);
02280 CLOSE(CHAN1);CLOSE(CHAN2);CLOSE(CHAN3);
02285 CLOSE(CHAN4);CLOSE(CHAN5);CLOSE(CHAN6);
02290
02300 END "MARKX";
02310